..`W0 mPLATFORMCUNIQUEIDC TIMESTAMPN CLASSMCLASSLOCM!BASECLASSM%OBJNAMEM)PARENTM-PROPERTIESM1PROTECTEDM5METHODSM9OBJCODEM=OLEMAOLE2MERESERVED1MIRESERVED2MMRESERVED3MQRESERVED4MURESERVED5MYRESERVED6M]RESERVED7MaRESERVED8MeUSERMi COMMENT Screen  WINDOWS _QTS0I9HEP 546203848/F\ WINDOWS _QTR0X0BGR 658212118" WINDOWS _QTS0I9HEP 546244022 r WINDOWS _QTS0I9HEP 551043836:Odt$O WINDOWS _R9L06FHTB 579769148p WINDOWS _R9L06FHUA 606638154q)G WINDOWS _R9L18TP16 579770109! WINDOWS _QTS0I9HEP 591747627 WINDOWS _R9L1DGFDH 591747627tfY WINDOWS _R9L1DGFE2 591747627L?1$ WINDOWS _RJR12MGOY 579768358~^P?2 COMMENT RESERVED +"VERSION = 3.00dataenvironmentdataenvironmentDatanavigationILeft = 1 Top = 220 Width = 520 Height = 120 Name = "Datanavigation" 12formformForm1DataSession = 2 ScaleMode = 3 Height = 215 Width = 447 DoCreate = .T. AutoCenter = .T. BorderStyle = 2 Caption = "Custom Labels" MaxButton = .F. MinButton = .F. WindowType = 1 WindowState = 0 Name = "Form1"  PROCEDURE deletelabel #DEFINE LBLREGKEY1 "Software\Microsoft\VisualFoxPro\" #DEFINE LBLREGKEY2 "\Labels" #DEFINE HKEY_CURRENT_USER -2147483647 && BITSET(0,31)+1 LPARAMETERS cLblName LOCAL nRetCode, cLblRegKey cLblRegKey = LBLREGKEY1 + _VFP.Version + LBLREGKEY2 * Need to remove Registry entry if any m.cLblName= ALLTRIM(m.cLblName) + CHR(0) nRetCode = THISFORM.oRegistry.DeleteKeyValue(m.cLblName, m.cLblRegKey, HKEY_CURRENT_USER) ENDPROC PROCEDURE Init #DEFINE USERLBLS_LOC "userlbls.dbf" #DEFINE LBLSPATH "Tools\AddLabel\" #DEFINE cWhere_loc "Where is "+USERLBLS_LOC+"?" #DEFINE cFILEINUSE_LOC "Could not open Userlbls table. Check to see if this table is in use by another." LOCAL cLblsFile,aDirArray,nDirs DIME aDirArray[1] SET DELETED ON SET EXCLUSIVE ON DO CASE CASE FILE(USERLBLS_LOC) *This.label_file = "labels" cLblsFile = USERLBLS_LOC CASE FILE(HOME()+USERLBLS_LOC) cLblsFile = HOME()+USERLBLS_LOC CASE FILE(HOME()+LBLSPATH+USERLBLS_LOC) cLblsFile = HOME()+LBLSPATH+USERLBLS_LOC OTHERWISE cLblsFile = "" ENDCASE IF EMPTY(m.cLblsFile) * Create a new one nDirs = ADIR(aDirArray,HOME()+LBLSPATH,"D") IF m.nDirs # 0 cLblsFile = HOME()+LBLSPATH+USERLBLS_LOC ELSE cLblsFile = HOME()+USERLBLS_LOC ENDIF CREATE TABLE (m.cLblsFile) ; (TYPE c(12),; ID c(12),; NAME c(24),; READONLY L,; CKVAL N(6),; DATA M,; UPDATED D) * This.label_file = GETFILE("DBF",cWhere_loc) ELSE USE (m.cLblsFile) ALIAS userlbls ENDIF IF EMPTY(ALIAS()) * We had an error opening file, may be in use. * Try opening it shared USE (m.cLblsFile) ALIAS userlbls SHARED IF EMPTY(ALIAS()) = MESSAGEBOX(cFILEINUSE_LOC) RETURN .F. ENDIF ELSE This.label_file = ALIAS() ENDIF SELECT 0 CREATE CURSOR WzLabels ; (Name C(30),; LblDimen C(40),; LblColumns C(2),; Data M) SELECT userlbls SCAN FOR ID="LABELLYT" AND !DELETED() INSERT INTO WzLabels (Name, LblDimen, LblColumns,Data); VALUE (userlbls.Name,; ALLTRIM(SUBSTR(userlbls.Data,15,11))+" x "+ALLTRIM(SUBSTR(userlbls.Data, 26, 11)), ; ALLTRIM(SUBSTR(userlbls.Data, 37, 2)),; userlbls.Data) ENDSCAN SELECT wzlabels THIS.lstLabels.RowSource = "Name, LblDimen, LblColumns" THIS.lstLabels.Value = 1 THIS.lstLabels.ColumnWidths = "120,140,130" THIS.OldF1 = ON("KEY","F1") ON KEY LABEL F1 HELP ID 489321235 THISFORM.REFRESH ENDPROC PROCEDURE Refresh IF THIS.lstLabels.ListCount = 0 THIS.cmdDelete.Enabled = .F. THIS.cmdEdit.Enabled = .F. ELSE THIS.cmdEdit.Enabled = .T. THIS.cmdDelete.Enabled = .T. ENDIF ENDPROC PROCEDURE Destroy LOCAL tmpF1 IF EMPTY(THIS.OldF1) ON KEY LABEL F1 ELSE tmpF1 = THIS.OldF1 ON KEY LABEL F1 &tmpF1 ENDIF ENDPROC  ?n%> &UTCNewLabelaF%C fCCf ^C F   U CSAVENAMENAMENEWLABELUSERLBLSTHISFORM DELETELABELWZLABELS LSTLABELSSETFOCUSREFRESHClick,1qAr1Aq2$)! |B%U R%8C*Are you sure you want to delete the label?$x aBTCCf TF-CCf C' %C4FC    U CNAMECREGNAMETHISFORM LSTLABELS LISTCOUNTNAMEUSERLBLSWZLABELS DELETELABELSETFOCUSREFRESHClick,1"AAqAAqA22) %]uoUCUTHISFORMCMDEDITCLICKDblClick,11,) ]i% UGF %C6 -C' %C4233 UUSERLBLSTHISFORMRELEASEClick,1qAQAA1) ]%U1NewLabelF  UNEWLABELWZLABELSTHISFORM LSTLABELSSETFOCUSREFRESHClick,1q1a)JArial, 0, 9, 5, 15, 12, 16, 3, 0 MS Sans Serif, 0, 8, 5, 13, 11, 11, 2, 0 DTop = 180 Left = 408 Height = 17 Width = 20 Name = "oRegistry" Form1 oRegistrycustom..\wzcommon\registry.vcxregistryFontName = "MS Sans Serif" FontSize = 8 BackStyle = 0 Caption = "Columns" Height = 15 Left = 280 Top = 12 Width = 69 Name = "Label3" Form1Label3labellabelForm1Label2labellabelForm1"label_file oldf1 *deletelabel  commandbutton commandbuttoncmdNewForm1Top = 110 Left = 364 Height = 23 Width = 72 FontName = "MS Sans Serif" FontSize = 8 Caption = "\T Software\Microsoft\VisualFoxPro\C\LabelsT C C &TC  UCLBLNAMENRETCODE CLBLREGKEYVERSIONTHISFORM OREGISTRYDELETEKEYVALUE G G H5 C userlbls.dbf0iT userlbls.dbf CCQ userlbls.dbf0TCQ userlbls.dbf2 CCQTools\AddLabel\ userlbls.dbf00TCQTools\AddLabel\ userlbls.dbf2 T%C +,TCCQTools\AddLabel\D% 0TCQTools\AddLabel\ userlbls.dbfTCQ userlbls.dbfbh1 C C CLNM DCQ  %CCQ  %CC[COCould not open Userlbls table. Check to see if this table is in use by another.xB-T CFFhWzLabelsCC(CMF !~LABELLYTC' srWzLabels CC  \ x CC  \CC %\ F -T Name, LblDimen, LblColumnsT T  120,140,130T CKEYF112F1HELP ID 489321235 U CLBLSFILE ADIRARRAYNDIRSTYPEIDNAMEREADONLYCKVALDATAUPDATEDUSERLBLSTHIS LABEL_FILEWZLABELSLBLDIMEN LBLCOLUMNS LSTLABELS ROWSOURCEVALUE COLUMNWIDTHSOLDF1F1THISFORMREFRESHj%9T-T-cTaTaUTHIS LSTLABELS LISTCOUNT CMDDELETEENABLEDCMDEDIT`%C'{2F1YTON KEY LABEL F1 &tmpF1 UTMPF1THISOLDF1F1 deletelabel,InitRefreshtDestroy1ua3ba!A1A(AqAAer5Ar12qA3q!A2q 7 5 b?S l)%m2./,$d:\vfp\xpieces\addlabel\addlabel.scxUD0mPLATFORMCUNIQUEIDC TIMESTAMPN CLASSMCLASSLOCM!BASECLASSM%OBJNAMEM)PARENTM-PROPERTIESM1PROTECTEDM5METHODSM9OBJCODEM=OLEMAOLE2MERESERVED1MIRESERVED2MMRESERVED3MQRESERVED4MURESERVED5MYRESERVED6M]RESERVED7MaRESERVED8MeUSERMi COMMENT Screen  WINDOWS _R8T13G40P 544314328/F] WINDOWS _R8T13G40X 591748010r_o WINDOWS _R8T13G40P 551043889 ( WINDOWS _R8T13G43F 579768625 !!!S WINDOWS _R8T13G40P 551043616??? @@ WINDOWS _R8T13G45X 591746850@@AA'A WINDOWS _R8T13G472 591746850AAABB WINDOWS _R9K15742G 546151933CCC*C7C WINDOWS _R9K15742W 591746850CCCCC WINDOWS _R9K15743C 546182489$D3DBDTDaD WINDOWS _R9K157446 591746850ME\EkE|EE WINDOWS _R8T13G40P 546220955wFFFFFG#4 WINDOWS _R9K15745P 546182489xJJJJJK, WINDOWS _R9K15746I 546182489L?L?I WINDOWS _R8T13G40P 591748010????H WINDOWS _R9K15747V 591746850?t?`?S?9>>^ WINDOWS _R8T13G40P 546182151====y;L WINDOWS _R8T13G40P 591746850l;_;Q;D;: WINDOWS _R9K163WGW 546153523|:o:^:Q:9 WINDOWS _R9K163WHK 5510436169s9e9X98 WINDOWS _R9L05FSRW 591746850x8h8 2 5$ WINDOWS _RJR12X8YO 579768626"  aPC COMMENT RESERVED jVERSION = 3.00dataenvironmentdataenvironmentDataenvironmentName = "Dataenvironment" 11formformform1Height = 364 Width = 500 DoCreate = .T. AutoCenter = .T. BorderStyle = 2 Caption = "New Label Definition" MaxButton = .F. MinButton = .F. WindowType = 1 WindowState = 0 LockScreen = .F. lenglish = .T. cchangevalue = ("") Name = "form1" dPROCEDURE convertmm LPARAMETER cInValue,lwhichway * Converts metric values entered in millimeters to 10,000ths of an inch. LOCAL nInValue,cOutValue *!* nInValue = VAL(ALLTRIM(m.cInValue)) m.nInValue = m.cInValue IF !m.lwhichway * metric to english nInValue = ROUND(((m.nInValue*39.3700787402E-2)),4) ELSE * english to metric nInValue = ROUND(((m.nInValue/39.3700787402E-2)),4) ENDIF *!* cOutValue = ALLTRIM(STR(m.nInValue,8,3)) RETURN m.nInValue ENDPROC PROCEDURE resetlabel #DEFINE ENGMEASURE '"' #DEFINE METMEASURE 'cm' #DEFINE ENGPROMPT_LOC "Enter label measurements in inches:" #DEFINE METPROMPT_LOC "Enter label measurements in centimeters:" #DEFINE CMDADDCAP_LOC "\T C U THISFORM DESCRIPTIONENABLEDTHISVALUE LCHANGEDESCCDELIM CSAVEVALUE OGPMETRIC LABELHEIGHT LABELWIDTH CCHANGEVALUESETFOCUSClick,1AQ!A1aAA1) iiB% U9%   DB&TC" cm6T%6T#Enter label measurements in inches: TC T C  T C  T C  T C 7T CC ZCC Z;T(Enter label measurements in centimeters:!TCa!T C a!T C a!T C a!T C a% JT CC Z  x CC Z  UCDELIMTHISVALUETHISFORMLENGLISH LBLPROMPTCAPTION LEFTMARGIN CONVERTMM SPACESBETWEEN LABELWIDTH TOPMARGIN LABELHEIGHT DESCRIPTION LCHANGEDESCREFRESHClick,1vAAbBarAA1)i f%Pd^UTUTHISVALUEInit,11) L%A1U%B+T C" cm6JTCCZ  x CCZ UTHISFORM LCHANGEDESCCDELIM OGPMETRICVALUE DESCRIPTION LABELHEIGHT LABELWIDTH LostFocus,1AAq2) %Pe_U UTHISFORMRELEASEClick,11!)JArial, 0, 9, 5, 15, 12, 13, 3, 0 MS Sans Serif, 0, 8, 5, 13, 11, 11, 2, 0 CTop = 98 Left = 399 Height = 17 Width = 33 Name = "oRegistry" form1 oRegistrycustomilabel_file lenglish lchangedesc editmode cchangevalue *convertmm *resetlabel *labeltoregistry  commandbutton commandbutton cmdCancelform1Top = 38 Left = 408 Height = 23 Width = 72 FontName = "MS Sans Serif" FontSize = 8 Cancel = .T. Caption = "Cancel" TabIndex = 11 Name = "cmdCancel" ,PROCEDURE Click THISFORM.RELEASE ENDPROC ..\wzcommon\registry.vcxregistry}Top = 42 Left = 360 Height = 17 Width = 36 FontName = "MS Sans Serif" FontSize = 8 Caption = "\ C 0C$Please supply a value for Label Namex B C  2C&Please supply a value for Label Heightx  B C  C1C%Please supply a value for Label Widthx  B C  3C'Please supply a value for Number Acrossx  BT F% #-CCfCC fC' %C4_%CHA label with the same name already exists, would you like to replace it?$x\B T aT  T -CCfCC fC' T aT  T  T  T  T  %  TC TC  TC  TC  TC  TCCC T'ZTCCC T'ZTCCC T'ZTCCC T'ZTCCC T'Z*T C  "cm6&T CCC  =  % tTCC  =TCX %ZTCC\ TCCC\ T    pT -%  0T  CCC  Z  0T  CCC  Z  -T  CCC  Z  T C C  C 0CCC  Z0C 0C 0C 0C 0C  TF6% 8>  CCC \]g! F-CCfCC fC' %C4e> "CC! \ x CC! \#CC!%\! xdruserlblsDATAWLABELLYT -CCC \]g srWzLabels"#!CC! \ x CC! \CC!%\! $PR,@New Label Layout successfully added to labels file and registry. %U& NLEFTMARGNSPACENLBLWIDNTOPMARGNLBLHGTCDATAFLDCDESCCDELIMLEXISTS CSAVENAMETHISFORM LAYOUTNAMEVALUESETFOCUS LABELHEIGHT LABELWIDTH NUMBERACROSSUSERLBLSEDITMODENAMEWZLABELS LEFTMARGIN SPACESBETWEEN TOPMARGIN OGPMETRIC CONVERTMM LCHANGEDESCNSEPPOSCPART1CPART2CTMPSTR DESCRIPTIONCKVALDATALBLDIMEN LBLCOLUMNSLABELTOREGISTRYRELEASEClick,1=1QAQ!AQAQ1AAqC2AAQA"A21111rqqqqAb1QAAA qTAC5A2V)  E , , % V U  T  %  Y"TC  8Dd2?T"TC  8Dd2? T B UCINVALUE LWHICHWAYNINVALUE COUTVALUETCT\T Software\Microsoft\VisualFoxPro\C\Labels!TC  a%/C#Could not write labels to Registry.xBTC 6R,:+Updating Registry with label definitions...~ TT C T CC \.T C     % /C#Could not write labels to Registry.x!R U NRETCODE NSAVEAREACGETNAMECGETDATA CLBLREGKEYVERSIONTHIS OREGISTRYOPENKEYCLOSEKEYNAMEDATA SETREGKEYh4(%C m.lEditModebL IT aTU LEDITMODETHISEDITMODE RESETLABEL convertmm, resetlabellabeltoregistryInit& 1""A271qABAAAArAbrQ1!qaAA2wAAAba1AAAR2qA2  9 uQNYq), BMֽv(`wwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwpwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwpwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwpwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwpwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwBM/>(X/???0 mPLATFORMCUNIQUEIDC TIMESTAMPN CLASSMCLASSLOCM!BASECLASSM%OBJNAMEM)PARENTM-PROPERTIESM1PROTECTEDM5METHODSM9OBJCODEM=OLEMAOLE2MERESERVED1MIRESERVED2MMRESERVED3MQRESERVED4MURESERVED5MYRESERVED6M]RESERVED7MaRESERVED8MeUSERMi COMMENT Class  WINDOWS _RJL0UQOZ1 579367670 )7HZ6&% COMMENT RESERVED } WINDOWS _RJL0UV82J 579367771i~q COMMENT RESERVED cG WINDOWS _RJL0UXJVX 5793678293AO* COMMENT RESERVED  WINDOWS _RJL0V1NVV 579434725j\BH/d}o] COMMENT RESERVED N2 WINDOWS _RJL0U66ZY 656509588z3aDdq]@VD COMMENT RESERVED 4VERSION = 3.00 registry.hk+registry registry.hPixelsClass1customregistrynuserkey = 0 cvfpoptpath = cregdllfile = cinidllfile = codbcdllfile = ncurrentos = 0 ncurrentkey = 0 capppathkey = Name = "registry" customcustomName = "odbcreg"  registry.vcx registry.hk+ oldinireg1odbcregregistryClassPixels registry.hodbcreg registry.hk+1 registry.vcx registry.hk+foxreg registry.hPixelsClass1registryfoxregName = "foxreg" custom registry.hPixelsregistry1Class registry.hk+filereg registry.hPixelsClassregistryfilereg*setfoxoption Sets an option from FoxPro registry settings. *getfoxoption Retrieves an option from FoxPro registry settings. *enumfoxoptions Name = "filereg" custom registry.vcxPROCEDURE setfoxoption LPARAMETER cOptName,cOptVal RETURN THIS.SetRegKey(cOptName,cOptVal,THIS.cVFPOptPath,THIS.nUserKey) ENDPROC PROCEDURE getfoxoption LPARAMETER cOptName,cOptVal RETURN THIS.GetRegKey(cOptName,@cOptVal,THIS.cVFPOptPath,THIS.nUserKey) ENDPROC PROCEDURE enumoptions LPARAMETER aFoxOpts RETURN THIS.EnumOptions(@aFoxOpts,THIS.cVFPOptPath,THIS.nUserKey,.F.) ENDPROC  registry.vcxcustom oldiniregName = "oldinireg"  l%-1U  T/%C m.cExtensionbC C > d BT . TC %  B TC C %  B BC U CEXTENSIONCEXTNKEYCAPPKEYLSERVERNERRNUMCOPTNAMETHISOPENKEY GETKEYVALUECLOSEKEYGETAPPLICATION  T!TC \CurVer% j B TC C %  B BC U CCLASSCEXTNKEYCAPPKEYLSERVERNERRNUMCOPTNAMETHISOPENKEY GETKEYVALUECLOSEKEYGETAPPLICATION 4  T&%C m.lServerbL  |/T\Protocol\StdFileEditing\Server#T\Shell\Open\CommandT C %  B TC C B U CEXTNKEYCAPPKEYLSERVERNERRNUMCOPTNAMETHIS CAPPPATHKEYOPENKEY GETKEYVALUECLOSEKEY getapppath,getlatestversiongetapplication13Aas1A2A311A2A3c1A1A2 !8) }}ђ%KnU% B%C9 B     -|W SQLDrivers% B2|WSQLDataSourcesTa BUTHIS LLOADEDODBCS CODBCDLLFILEHENV FDIRECTION SZDRIVERDESCCBDRIVERDESCMAX PCBDRIVERDESCSZDRIVERATTRIBUTES CBDRVRATTRMAX PCBDRVRATTRSZDSNCBDSNMAXPCBDSN SZDESCRIPTIONCBDESCRIPTIONMAXPCBDESCRIPTION SQLDRIVERS LHADERRORSQLDATASOURCES! 40TCCm.lDataSourcesbL -6TC %  B TCC ]g%C B#C 6T +aTCdXTCdX T T% y-TC d -TC dd  H  d T!   !2 %CC x% OCtCTC .TCC C >=%  TC .TCC C >= BU ADRVRS LDATASOURCESNODBCENVNRETVALDSNDSNDESCMDSNMDESCTHIS LOADODBCFUNCSSQLDATASOURCES SQLDRIVERSa .TSoftware\ODBC\ODBCINST.INI\ BC  -U ADRVROPTS CODBCDRIVER CSOURCEKEYTHIS ENUMOPTIONS[ (TSoftware\ODBC\ODBC.INI\BC  -U ADRVROPTS CDATASOURCE CSOURCEKEYTHIS ENUMOPTIONS loadodbcfuncs, getodbcdrvrsH enumodbcdrvrs enumodbcdata~1A$A21A%31A#A21A1AAAAAAAA3q3q2 #A u eF < l)}? &&%h U/ !BCUCOPTNAMECOPTVALTHIS SETREGKEY CVFPOPTPATHNUSERKEY/ !BCUCOPTNAMECOPTVALTHIS GETREGKEY CVFPOPTPATHNUSERKEY(BC-UAFOXOPTSTHIS ENUMOPTIONS CVFPOPTPATHNUSERKEY setfoxoption, getfoxoption enumoptions133q2}( )&*getapppath Checks and returns path of application associated with a particular extension (e.g., XLS, DOC). *getlatestversion Returns latest version for a specified application. *getapplication Retrieves application key. *getinisection Retrieves information from INI section. *getinientry Retrieves information from INI entry. *writeinientry Writes a specific INI entry. *loadinifuncs Loads functions needed for reading INI files. *loadodbcfuncs Loads ODBC registry functions. *getodbcdrvrs Retrieves ODBC drivers. *enumodbcdrvrs Enumerates through ODBC drivers. *enumodbcdata Enumerates through ODBC data sources.  GPROCEDURE loadodbcfuncs IF THIS.lLoadedODBCs RETURN ERROR_SUCCESS ENDIF * Check API file containing functions IF EMPTY(THIS.cODBCDLLFile) RETURN ERROR_NOODBCFILE ENDIF LOCAL henv,fDirection,szDriverDesc,cbDriverDescMax LOCAL pcbDriverDesc,szDriverAttributes,cbDrvrAttrMax,pcbDrvrAttr LOCAL szDSN,cbDSNMax,pcbDSN,szDescription,cbDescriptionMax,pcbDescription DECLARE Short SQLDrivers IN (THIS.cODBCDLLFile) ; Integer henv, Integer fDirection, ; String @ szDriverDesc, Integer cbDriverDescMax, Integer pcbDriverDesc, ; String @ szDriverAttributes, Integer cbDrvrAttrMax, Integer pcbDrvrAttr IF THIS.lhaderror && error loading library RETURN -1 ENDIF DECLARE Short SQLDataSources IN (THIS.cODBCDLLFile) ; Integer henv, Integer fDirection, ; String @ szDSN, Integer cbDSNMax, Integer @ pcbDSN, ; String @ szDescription, Integer cbDescriptionMax,Integer pcbDescription THIS.lLoadedODBCs = .T. RETURN ERROR_SUCCESS ENDPROC PROCEDURE getodbcdrvrs PARAMETER aDrvrs,lDataSources LOCAL nODBCEnv,nRetVal,dsn,dsndesc,mdsn,mdesc lDataSources = IIF(TYPE("m.lDataSources")="L",m.lDataSources,.F.) * Load API functions nRetVal = THIS.LoadODBCFuncs() IF m.nRetVal # ERROR_SUCCESS RETURN m.nRetVal ENDIF * Get ODBC environment handle nODBCEnv=VAL(SYS(3053)) * -- Possible error messages * 527 "cannot load odbc library" * 528 "odbc entry point missing" * 182 "not enough memory" IF INLIST(nODBCEnv,527,528,182) * Failed RETURN ERROR_ODBCFAIL ENDIF DIMENSION aDrvrs[1,IIF(m.lDataSources,2,1)] aDrvrs[1] = "" DO WHILE .T. dsn=space(100) dsndesc=space(100) mdsn=0 mdesc=0 * Return drivers or data sources IF m.lDataSources nRetVal = SQLDataSources(m.nODBCEnv,SQL_FETCH_NEXT,@dsn,100,@mdsn,@dsndesc,255,@mdesc) ELSE nRetVal = SQLDrivers(m.nODBCEnv,SQL_FETCH_NEXT,@dsn,100,@mdsn,@dsndesc,100,@mdesc) ENDIF DO CASE CASE m.nRetVal = SQL_NO_DATA nRetVal = ERROR_SUCCESS EXIT CASE m.nRetVal # ERROR_SUCCESS AND m.nRetVal # 1 EXIT OTHERWISE IF !EMPTY(aDrvrs[1]) IF m.lDataSources DIMENSION aDrvrs[ALEN(aDrvrs,1)+1,2] ELSE DIMENSION aDrvrs[ALEN(aDrvrs,1)+1,1] ENDIF ENDIF dsn = ALLTRIM(m.dsn) aDrvrs[ALEN(aDrvrs,1),1] = LEFT(m.dsn,LEN(m.dsn)-1) IF m.lDataSources dsndesc = ALLTRIM(m.dsndesc) aDrvrs[ALEN(aDrvrs,1),2] = LEFT(m.dsndesc,LEN(m.dsndesc)-1) ENDIF ENDCASE ENDDO RETURN nRetVal ENDPROC PROCEDURE enumodbcdrvrs LPARAMETER aDrvrOpts,cODBCDriver LOCAL cSourceKey cSourceKey = ODBC_DRVRS_KEY+m.cODBCDriver RETURN THIS.EnumOptions(@aDrvrOpts,m.cSourceKey,HKEY_LOCAL_MACHINE,.F.) ENDPROC PROCEDURE enumodbcdata LPARAMETER aDrvrOpts,cDataSource LOCAL cSourceKey cSourceKey = ODBC_DATA_KEY+cDataSource RETURN THIS.EnumOptions(@aDrvrOpts,m.cSourceKey,HKEY_CURRENT_USER,.F.) ENDPROC g NN%DMUD4 T%C m.cINIFilebCZ T&%C  BTCC   T( 4T CC  )T C   \T  BU ASECTIONSCSECTIONCINIFILE CINIVALUE NTOTENTRIESINLASTPOSTHIS GETINIENTRYNTMPPOSY TCTC % a B %  T T CX%C *T C  C > 0T C  C >  % 1 BT C  = BU CVALUECSECTIONCENTRYCINIFILECBUFFERNBUFSIZENERRNUM NTOTPARMSTHIS LOADINIFUNCS GETWININI GETPRIVATEINITC% I B %C ~ TC   &TC   BC  6U CVALUECSECTIONCENTRYCINIFILENERRNUMTHIS LOADINIFUNCS WRITEWININIWRITEPRIVATEINIW% BG|GetPrivateProfileStringWin32APIQ GetPrivateINI%~ B:|GetProfileStringWin32APIQ GetWinINI:|WriteProfileStringWin32APIQ WriteWinINIG|WritePrivateProfileStringWin32APIQWritePrivateINITa BU THIS LLOADEDINISGETPRIVATEPROFILESTRINGWIN32API GETPRIVATEINI LHADERRORGETPROFILESTRING GETWININIWRITEPROFILESTRING WRITEWININIWRITEPRIVATEPROFILESTRINGWRITEPRIVATEINI getinisection, getinientry writeinientry loadinifuncs11AbAb1A3131A3A"A2A31s1AbA3AsAs26XF*j=?7` W)N PROCEDURE getapppath * Checks and returns path of application * associated with a particular extension (e.g., XLS, DOC). LPARAMETER cExtension,cExtnKey,cAppKey,lServer LOCAL nErrNum,cOptName cOptName = "" * Check Extension parameter IF TYPE("m.cExtension") # "C" OR LEN(m.cExtension) > 3 RETURN ERROR_BADPARM ENDIF m.cExtension = "."+m.cExtension * Open extension key nErrNum = THIS.OpenKey(m.cExtension) IF m.nErrNum # ERROR_SUCCESS RETURN m.nErrNum ENDIF * Get key value for file extension nErrNum = THIS.GetKeyValue(cOptName,@cExtnKey) * Close extension key THIS.CloseKey() IF m.nErrNum # ERROR_SUCCESS RETURN m.nErrNum ENDIF RETURN THIS.GetApplication(cExtnKey,@cAppKey,lServer) ENDPROC PROCEDURE getlatestversion LPARAMETER cClass,cExtnKey,cAppKey,lServer LOCAL nErrNum,cOptName cOptName = "" * Open class key (e.g., Excel.Sheet) nErrNum = THIS.OpenKey(m.cClass+CURVER_KEY) IF m.nErrNum # ERROR_SUCCESS RETURN m.nErrNum ENDIF * Get key value for file extension nErrNum = THIS.GetKeyValue(cOptName,@cExtnKey) * Close extension key THIS.CloseKey() IF m.nErrNum # ERROR_SUCCESS RETURN m.nErrNum ENDIF RETURN THIS.GetApplication(cExtnKey,@cAppKey,lServer) ENDPROC PROCEDURE getapplication PARAMETER cExtnKey,cAppKey,lServer LOCAL nErrNum,cOptName cOptName = "" * lServer - checking for OLE server. IF TYPE("m.lServer") = "L" AND m.lServer THIS.cAppPathKey = OLE_PATH_KEY ELSE THIS.cAppPathKey = APP_PATH_KEY ENDIF * Open extension app key m.nErrNum = THIS.OpenKey(m.cExtnKey+THIS.cAppPathKey) IF m.nErrNum # ERROR_SUCCESS RETURN m.nErrNum ENDIF * Get application path nErrNum = THIS.GetKeyValue(cOptName,@cAppKey) * Close application path key THIS.CloseKey() RETURN m.nErrNum ENDPROC  PROCEDURE getinisection PARAMETERS aSections,cSection,cINIFile LOCAL cINIValue, nTotEntries, i, nLastPos cINIValue = "" IF TYPE("m.cINIFile") # "C" cINIFile = "" ENDIF IF THIS.GetINIEntry(@cINIValue,cSection,0,m.cINIFile) # ERROR_SUCCESS RETURN ERROR_FAILINI ENDIF nTotEntries=OCCURS(CHR(0),m.cINIValue) DIMENSION aSections[m.nTotEntries] nLastPos = 1 FOR i = 1 TO m.nTotEntries nTmpPos = AT(CHR(0),m.cINIValue,m.i) aSections[m.i] = SUBSTR(m.cINIValue,m.nLastPos,m.nTmpPos-m.nLastPos) nLastPos = m.nTmpPos+1 ENDFOR RETURN ERROR_SUCCESS ENDPROC PROCEDURE getinientry LPARAMETER cValue,cSection,cEntry,cINIFile * Get entry from INI file LOCAL cBuffer,nBufSize,nErrNum,nTotParms nTotParms = PARAMETERS() * Load API functions nErrNum= THIS.LoadINIFuncs() IF m.nErrNum # ERROR_SUCCESS RETURN m.nErrNum ENDIF * Parameter checks here IF m.nTotParms < 3 m.cEntry = 0 ENDIF m.cBuffer=space(2000) IF EMPTY(m.cINIFile) * WIN.INI file m.nBufSize = GetWinINI(m.cSection,m.cEntry,"",@cBuffer,LEN(m.cBuffer)) ELSE * Private INI file m.nBufSize = GetPrivateINI(m.cSection,m.cEntry,"",@cBuffer,LEN(m.cBuffer),m.cINIFile) ENDIF IF m.nBufSize = 0 &&could not find entry in INI file RETURN ERROR_NOINIENTRY ENDIF m.cValue=LEFT(m.cBuffer,m.nBufSize) ** All is well RETURN ERROR_SUCCESS ENDPROC PROCEDURE writeinientry LPARAMETER cValue,cSection,cEntry,cINIFile * Get entry from INI file LOCAL nErrNum * Load API functions nErrNum = THIS.LoadINIFuncs() IF m.nErrNum # ERROR_SUCCESS RETURN m.nErrNum ENDIF IF EMPTY(m.cINIFile) * WIN.INI file nErrNum = WriteWinINI(m.cSection,m.cEntry,m.cValue) ELSE * Private INI file nErrNum = WritePrivateINI(m.cSection,m.cEntry,m.cValue,m.cINIFile) ENDIF ** All is well RETURN IIF(m.nErrNum=1,ERROR_SUCCESS,m.nErrNum) ENDPROC PROCEDURE loadinifuncs * Loads funtions needed for reading INI files IF THIS.lLoadedINIs RETURN ERROR_SUCCESS ENDIF DECLARE integer GetPrivateProfileString IN Win32API ; AS GetPrivateINI string,string,string,string,integer,string IF THIS.lhaderror && error loading library RETURN -1 ENDIF DECLARE integer GetProfileString IN Win32API ; AS GetWinINI string,string,string,string,integer DECLARE integer WriteProfileString IN Win32API ; AS WriteWinINI string,string,string DECLARE integer WritePrivateProfileString IN Win32API ; AS WritePrivateINI string,string,string,string THIS.lLoadedINIs = .T. * Need error check here RETURN ERROR_SUCCESS ENDPROC nuserkey User registry key. cvfpoptpath Registry path to VFP options settings. cregdllfile DLL file for registry functions. cinidllfile DLL file for INI functions. codbcdllfile DLL file for ODBC functions. ncurrentos Current operating system code. ncurrentkey Current registry key. lloadeddlls Whether registry key functions loaded. lloadedinis Whether INI functions loaded. capppathkey Application path registry key. lcreatekey Whether to create key if one does not already exist. lhaderror Whether an error occurred. lloadedodbcs Whether ODBC functions loaded. *loadregfuncs Loads funtions needed for Registry. *openkey Opens a registry key. *closekey Closes a registry key. *setregkey Sets a registry key setting. *getregkey Gets a registry key setting. *getkeyvalue Obtains a value from a registry key. *setkeyvalue Sets a key value. *deletekey Deletes a registry key. *enumoptions Enumerates through all entries for a key and populates array. *iskey Checks to see if a key exists. *enumkeys Enumerates through a registry key. *enumkeyvalues Enumerates through values of a registry key *deletekeyvalue Deletes value from registry key.   %}UU     %x B%| RegOpenKeyWin32API% B'| RegCreateKeyWin32API$| RegDeleteKeyWin32API%|RegDeleteValueWin32API | RegCloseKeyWin32API,| RegSetValueExWin32API1|RegQueryValueExWin32API'| RegEnumKeyWin32API4| RegEnumKeyExWin32API4| RegEnumValueWin32APITa BU"NHKEYCSUBKEYNRESULTHKEYIVALUE LPSZVALUE LPCCHVALUELPDWTYPELPBDATALPCBDATALPCSTRLPSZVALNLEN LPDWRESERVED LPSZVALUENAME DWRESERVEDFDWTYPEISUBKEYLPSZNAMECCHNAMETHIS LLOADEDDLLS REGOPENKEYWIN32API LHADERROR REGCREATEKEY REGDELETEKEYREGDELETEVALUE REGCLOSEKEY REGSETVALUEEXREGQUERYVALUEEX REGENUMKEY REGENUMKEYEX REGENUMVALUE T TC(%C m.nRegKeybNC  zT  TC%  B T-% C m.lCreateKeybL T %2TC   XTC   T % B T   BU CLOOKUPKEYNREGKEY LCREATEKEYNSUBKEYNERRCODENPCOUNTLSAVECREATEKEYTHIS LOADREGFUNCS REGCREATEKEY REGOPENKEY NCURRENTKEY#CTU REGCLOSEKEYTHIS NCURRENTKEY T T T%T C    %  B TC  C B U COPTNAMECOPTVALCKEYPATHNUSERKEY LCREATEKEYIPOSCOPTKEYCOPTIONNERRNUMTHISOPENKEY SETKEYVALUECLOSEKEY T T TT C   %  B TC C B U COPTNAMECOPTVALCKEYPATHNUSERKEYIPOSCOPTKEYCOPTIONNERRNUMTHISOPENKEY GETKEYVALUECLOSEKEYs J(JCX(JC >(  Hc2 CTHIS.nCurrentKeybN   B C m.cValueNamebC B.T C  %  B  %   G BT C  = BU CVALUENAME CKEYVALUE LPDWRESERVEDLPDWTYPELPBDATALPCBDATANERRCODETHIS NCURRENTKEYREGQUERYVALUEEX6   H#2 CTHIS.nCurrentKeybN  _ B6 C m.cValueNamebCCm.cValuebC  B C T C TC >.T C   % & B  BU CVALUENAMECVALUE NVALUESIZENERRCODETHIS NCURRENTKEY REGSETVALUEEXI  TT C  B UNUSERKEYCKEYPATHNERRNUM REGDELETEKEY& T T T)%C C m.lEnumKeysbL  T-T C   %  B % TC TC  C B U AREGOPTSCOPTPATHNUSERKEY LENUMKEYSIPOSCOPTKEYCOPTIONNERRNUMTHISOPENKEYENUMKEYS ENUMKEYVALUESCLOSEKEYe TC % O CB UCKEYNAMENREGKEYNERRNUMTHISOPENKEYCLOSEKEY4 T  +a TTCdXTC >TCdXTC >TCdX3T C  H ! !TC TC C >=%CC lCTC T !%   T  B U AKEYNAMES NKEYENTRYCNEWKEYCNEWSIZECBUFNBUFLENCRETTIMENKEYSIZENERRCODE REGENUMKEYEXTHIS NCURRENTKEY J(2%CTHIS.nCurrentKeybN  } B%  B +aJ(JCX(JC>( JC>( 4TC   H;j S! j!T  $T C  = H (T C  = 4#T *Binary* m(T C  =2)T *Unknown type*!%   T  B U AKEYVALUES LPSZVALUE LPCCHVALUE LPDWRESERVEDLPDWTYPELPBDATALPCBDATANERRCODE NKEYENTRY LARRAYPASSEDTHIS NCURRENTKEY NCURRENTOS REGENUMVALUE  T TT C  % q B T C  C B U COPTNAMECKEYPATHNUSERKEYCOPTIONNERRNUMTHISOPENKEYREGDELETEVALUE NCURRENTKEYCLOSEKEYT BT Software\Microsoft\VisualFoxPro\C\Options Hb 24 3 B-! C Windows 3CJT" C Windows NTCJ6TT ADVAPI32.DLLT KERNEL32.DLLT ODBC32.DLL2TT ADVAPI32.DLLT KERNEL32.DLLT ODBC32.DLLUTHISNUSERKEY CVFPOPTPATHVERSION NCURRENTOS CREGDLLFILE CINIDLLFILE CODBCDLLFILE+Ta CCExUNERRORCMETHODNLINETHIS LHADERROR loadregfuncs,openkeyclosekey2 setregkeyy getregkey getkeyvalue setkeyvalue deletekeyh enumoptions iskeyenumkeys$ enumkeyvaluesdeletekeyvalue Init Error%11ASAsCSsDE32qA1A!AA"A"33u1S1A3511A3r1!A3AA3!aBS3A3q321A1ARRA3q1A3q2AA1AAAAA1AA3r"ACARACAA1AA2SA2AAA31A31!q!A32 :43 c7 iD AQcfwc}5=\p#:# %w$%b'~'')'PROCEDURE loadregfuncs * Loads funtions needed for Registry LOCAL nHKey,cSubKey,nResult LOCAL hKey,iValue,lpszValue,lpcchValue,lpdwType,lpbData,lpcbData LOCAL lpcStr,lpszVal,nLen,lpdwReserved LOCAL lpszValueName,dwReserved,fdwType LOCAL iSubKey,lpszName,cchName IF THIS.lLoadedDLLs RETURN ERROR_SUCCESS ENDIF DECLARE Integer RegOpenKey IN Win32API ; Integer nHKey, String @cSubKey, Integer @nResult IF THIS.lhaderror && error loading library RETURN -1 ENDIF DECLARE Integer RegCreateKey IN Win32API ; Integer nHKey, String @cSubKey, Integer @nResult DECLARE Integer RegDeleteKey IN Win32API ; Integer nHKey, String @cSubKey DECLARE Integer RegDeleteValue IN Win32API ; Integer nHKey, String cSubKey DECLARE Integer RegCloseKey IN Win32API ; Integer nHKey DECLARE Integer RegSetValueEx IN Win32API ; Integer hKey, String lpszValueName, Integer dwReserved,; Integer fdwType, String lpbData, Integer cbData DECLARE Integer RegQueryValueEx IN Win32API ; Integer nHKey, String lpszValueName, Integer dwReserved,; Integer @lpdwType, String @lpbData, Integer @lpcbData DECLARE Integer RegEnumKey IN Win32API ; Integer nHKey,Integer iSubKey, String @lpszName, Integer @cchName DECLARE Integer RegEnumKeyEx IN Win32API ; Integer nHKey,Integer iSubKey, String @lpszName, Integer @cchName,; Integer dwReserved,String @lpszName, Integer @cchName,String @cchName DECLARE Integer RegEnumValue IN Win32API ; Integer hKey, Integer iValue, String @lpszValue, ; Integer @lpcchValue, Integer lpdwReserved, Integer @lpdwType, ; String @lpbData, Integer @lpcbData THIS.lLoadedDLLs = .T. * Need error check here RETURN ERROR_SUCCESS ENDPROC PROCEDURE openkey * Opens a registry key LPARAMETER cLookUpKey,nRegKey,lCreateKey LOCAL nSubKey,nErrCode,nPCount,lSaveCreateKey nSubKey = 0 nPCount = PARAMETERS() IF TYPE("m.nRegKey") # "N" OR EMPTY(m.nRegKey) m.nRegKey = HKEY_CLASSES_ROOT ENDIF * Load API functions nErrCode = THIS.LoadRegFuncs() IF m.nErrCode # ERROR_SUCCESS RETURN m.nErrCode ENDIF lSaveCreateKey = THIS.lCreateKey IF m.nPCount>2 AND TYPE("m.lCreateKey") = "L" THIS.lCreateKey = m.lCreateKey ENDIF IF THIS.lCreateKey * Try to open or create registry key nErrCode = RegCreateKey(m.nRegKey,m.cLookUpKey,@nSubKey) ELSE * Try to open registry key nErrCode = RegOpenKey(m.nRegKey,m.cLookUpKey,@nSubKey) ENDIF THIS.lCreateKey = m.lSaveCreateKey IF nErrCode # ERROR_SUCCESS RETURN m.nErrCode ENDIF THIS.nCurrentKey = m.nSubKey RETURN ERROR_SUCCESS ENDPROC PROCEDURE closekey * Closes a registry key =RegCloseKey(THIS.nCurrentKey) THIS.nCurrentKey =0 ENDPROC PROCEDURE setregkey * This routine sets a registry key setting * ex. THIS.SetRegKey("ResWidth","640",; * "Software\Microsoft\VisualFoxPro\6.0\Options",; * HKEY_CURRENT_USER) LPARAMETER cOptName,cOptVal,cKeyPath,nUserKey,lCreateKey LOCAL iPos,cOptKey,cOption,nErrNum iPos = 0 cOption = "" nErrNum = ERROR_SUCCESS * Open registry key m.nErrNum = THIS.OpenKey(m.cKeyPath,m.nUserKey,m.lCreateKey) IF m.nErrNum # ERROR_SUCCESS RETURN m.nErrNum ENDIF * Set Key value nErrNum = THIS.SetKeyValue(m.cOptName,m.cOptVal) * Close registry key THIS.CloseKey() &&close key RETURN m.nErrNum ENDPROC PROCEDURE getregkey * This routine gets a registry key setting * ex. THIS.GetRegKey("ResWidth",@cValue,; * "Software\Microsoft\VisualFoxPro\4.0\Options",; * HKEY_CURRENT_USER) LPARAMETER cOptName,cOptVal,cKeyPath,nUserKey LOCAL iPos,cOptKey,cOption,nErrNum iPos = 0 cOption = "" nErrNum = ERROR_SUCCESS * Open registry key m.nErrNum = THIS.OpenKey(m.cKeyPath,m.nUserKey) IF m.nErrNum # ERROR_SUCCESS RETURN m.nErrNum ENDIF * Get the key value nErrNum = THIS.GetKeyValue(cOptName,@cOptVal) * Close registry key THIS.CloseKey() &&close key RETURN m.nErrNum ENDPROC PROCEDURE getkeyvalue * Obtains a value from a registry key * Note: this routine only handles Data strings (REG_SZ) LPARAMETER cValueName,cKeyValue LOCAL lpdwReserved,lpdwType,lpbData,lpcbData,nErrCode STORE 0 TO lpdwReserved,lpdwType STORE SPACE(256) TO lpbData STORE LEN(m.lpbData) TO m.lpcbData DO CASE CASE TYPE("THIS.nCurrentKey")#'N' OR THIS.nCurrentKey = 0 RETURN ERROR_BADKEY CASE TYPE("m.cValueName") #"C" RETURN ERROR_BADPARM ENDCASE m.nErrCode=RegQueryValueEx(THIS.nCurrentKey,m.cValueName,; m.lpdwReserved,@lpdwType,@lpbData,@lpcbData) * Check for error IF m.nErrCode # ERROR_SUCCESS RETURN m.nErrCode ENDIF * Make sure we have a data string data type IF m.lpdwType # REG_SZ AND m.lpdwType # REG_EXPAND_SZ RETURN ERROR_NONSTR_DATA ENDIF m.cKeyValue = LEFT(m.lpbData,m.lpcbData-1) RETURN ERROR_SUCCESS ENDPROC PROCEDURE setkeyvalue * This routine sets a key value * Note: this routine only handles data strings (REG_SZ) LPARAMETER cValueName,cValue LOCAL nValueSize,nErrCode DO CASE CASE TYPE("THIS.nCurrentKey")#'N' OR THIS.nCurrentKey = 0 RETURN ERROR_BADKEY CASE TYPE("m.cValueName") #"C" OR TYPE("m.cValue")#"C" RETURN ERROR_BADPARM CASE EMPTY(m.cValue) * RETURN ERROR_BADPARM ENDCASE * Make sure we null terminate this guy cValue = m.cValue+CHR(0) nValueSize = LEN(m.cValue) * Set the key value here m.nErrCode = RegSetValueEx(THIS.nCurrentKey,m.cValueName,0,; REG_SZ,m.cValue,m.nValueSize) * Check for error IF m.nErrCode # ERROR_SUCCESS RETURN m.nErrCode ENDIF RETURN ERROR_SUCCESS ENDPROC PROCEDURE deletekey * This routine deletes a Registry Key LPARAMETER nUserKey,cKeyPath LOCAL nErrNum nErrNum = ERROR_SUCCESS * Delete key m.nErrNum = RegDeleteKey(m.nUserKey,m.cKeyPath) RETURN m.nErrNum ENDPROC PROCEDURE enumoptions * Enumerates through all entries for a key and populates array LPARAMETER aRegOpts,cOptPath,nUserKey,lEnumKeys LOCAL iPos,cOptKey,cOption,nErrNum iPos = 0 cOption = "" nErrNum = ERROR_SUCCESS IF PARAMETERS()<4 OR TYPE("m.lEnumKeys") # "L" lEnumKeys = .F. ENDIF * Open key m.nErrNum = THIS.OpenKey(m.cOptPath,m.nUserKey) IF m.nErrNum # ERROR_SUCCESS RETURN m.nErrNum ENDIF * Enumerate through keys IF m.lEnumKeys * Enumerate and get key names nErrNum = THIS.EnumKeys(@aRegOpts) ELSE * Enumerate and get all key values nErrNum = THIS.EnumKeyValues(@aRegOpts) ENDIF * Close key THIS.CloseKey() &&close key RETURN m.nErrNum ENDPROC PROCEDURE iskey * Checks to see if a key exists LPARAMETER cKeyName,nRegKey LOCAL nErrNum * Open extension key nErrNum = THIS.OpenKey(m.cKeyName,m.nRegKey) IF m.nErrNum = ERROR_SUCCESS * Close extension key THIS.CloseKey() ENDIF RETURN m.nErrNum = ERROR_SUCCESS ENDPROC PROCEDURE enumkeys PARAMETER aKeyNames LOCAL nKeyEntry,cNewKey,cNewSize,cbuf,nbuflen,cRetTime nKeyEntry = 0 DIMENSION aKeyNames[1] DO WHILE .T. nKeySize = 0 cNewKey = SPACE(100) nKeySize = LEN(m.cNewKey) cbuf=space(100) nbuflen=len(m.cbuf) cRetTime=space(100) m.nErrCode = RegEnumKeyEx(THIS.nCurrentKey,m.nKeyEntry,@cNewKey,@nKeySize,0,@cbuf,@nbuflen,@cRetTime) DO CASE CASE m.nErrCode = ERROR_EOF EXIT CASE m.nErrCode # ERROR_SUCCESS EXIT ENDCASE cNewKey = ALLTRIM(m.cNewKey) cNewKey = LEFT(m.cNewKey,LEN(m.cNewKey)-1) IF !EMPTY(aKeyNames[1]) DIMENSION aKeyNames[ALEN(aKeyNames)+1] ENDIF aKeyNames[ALEN(aKeyNames)] = m.cNewKey nKeyEntry = m.nKeyEntry + 1 ENDDO IF m.nErrCode = ERROR_EOF AND m.nKeyEntry # 0 m.nErrCode = ERROR_SUCCESS ENDIF RETURN m.nErrCode ENDPROC PROCEDURE enumkeyvalues * Enumerates through values of a registry key LPARAMETER aKeyValues LOCAL lpszValue,lpcchValue,lpdwReserved LOCAL lpdwType,lpbData,lpcbData LOCAL nErrCode,nKeyEntry,lArrayPassed STORE 0 TO nKeyEntry IF TYPE("THIS.nCurrentKey")#'N' OR THIS.nCurrentKey = 0 RETURN ERROR_BADKEY ENDIF * Sorry, Win32s does not support this one! IF THIS.nCurrentOS = OS_W32S RETURN ERROR_BADPLAT ENDIF DO WHILE .T. STORE 0 TO lpdwReserved,lpdwType,nErrCode STORE SPACE(256) TO lpbData, lpszValue STORE LEN(lpbData) TO m.lpcchValue STORE LEN(lpszValue) TO m.lpcbData nErrCode=RegEnumValue(THIS.nCurrentKey,m.nKeyEntry,@lpszValue,; @lpcchValue,m.lpdwReserved,@lpdwType,@lpbData,@lpcbData) DO CASE CASE m.nErrCode = ERROR_EOF EXIT CASE m.nErrCode # ERROR_SUCCESS EXIT ENDCASE nKeyEntry = m.nKeyEntry + 1 * Set array values DIMENSION aKeyValues[m.nKeyEntry,2] aKeyValues[m.nKeyEntry,1] = LEFT(m.lpszValue,m.lpcchValue) DO CASE CASE lpdwType = REG_SZ aKeyValues[m.nKeyEntry,2] = LEFT(m.lpbData,m.lpcbData-1) CASE lpdwType = REG_BINARY * Don't support binary aKeyValues[m.nKeyEntry,2] = REG_BINARY_LOC CASE lpdwType = REG_DWORD * You will need to use ASC() to check values here. aKeyValues[m.nKeyEntry,2] = LEFT(m.lpbData,m.lpcbData-1) OTHERWISE aKeyValues[m.nKeyEntry,2] = REG_UNKNOWN_LOC ENDCASE ENDDO IF m.nErrCode = ERROR_EOF AND m.nKeyEntry # 0 m.nErrCode = ERROR_SUCCESS ENDIF RETURN m.nErrCode ENDPROC PROCEDURE deletekeyvalue LPARAMETER cOptName,cKeyPath,nUserKey LOCAL cOption,nErrNum cOption = cOptName nErrNum = ERROR_SUCCESS * Open key m.nErrNum = THIS.OpenKey(m.cKeyPath,m.nUserKey) IF m.nErrNum # ERROR_SUCCESS RETURN m.nErrNum ENDIF * Delete the key value m.nErrNum = RegDeleteValue(THIS.nCurrentKey,m.cOption) * Close key THIS.CloseKey() && close key RETURN m.nErrNum ENDPROC PROCEDURE Init THIS.nUserKey = HKEY_CURRENT_USER THIS.cVFPOptPath = VFP_OPTIONS_KEY1 + _VFP.VERSION + VFP_OPTIONS_KEY2 DO CASE CASE _DOS OR _UNIX OR _MAC RETURN .F. CASE ATC("Windows 3",OS(1)) # 0 THIS.nCurrentOS = OS_W32S CASE ATC("Windows NT",OS(1)) # 0 THIS.nCurrentOS = OS_NT THIS.cRegDLLFile = DLL_ADVAPI_NT THIS.cINIDLLFile = DLL_KERNEL_NT THIS.cODBCDLLFile = DLL_ODBC_NT OTHERWISE * Windows 95 THIS.nCurrentOS = OS_WIN95 THIS.cRegDLLFile = DLL_ADVAPI_WIN95 THIS.cINIDLLFile = DLL_KERNEL_WIN95 THIS.cODBCDLLFile = DLL_ODBC_WIN95 ENDCASE ENDPROC PROCEDURE Error LPARAMETERS nError, cMethod, nLine THIS.lhaderror = .T. =MESSAGEBOX(MESSAGE()) ENDPROC .\addlabel.scxaddlabel.sctc:\docume~1\vfpbuild\locals~1\temp\37p8024y.fxpnewlabel.scxnewlabel.sctlabel2.bmplabel2.msk..\wzcommon\registry.vcxregistry.vct )  4485A 85yCNyC8[8lhls[~[.~